perm filename PIX.SAI[PIX,HPM]37 blob
sn#304506 filedate 1977-09-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00054 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00007 00002 BEGIN "PIX"
C00013 00003 ["?"]
C00016 00004 ["T"] comment take a picture via a camera
C00018 00005 ["↑"] comment optimize clip levels
C00023 00006 ["←"] comment alter camera number
C00024 00007 ["B"] comment alter bits/pixel, size and # to average
C00026 00008 ["I"] comment input a file
C00028 00009 ["β"] comment input a font character
C00032 00010 ["+"] comment add an input a file
C00033 00011 ["*"] comment multiply by an input a file
C00034 00012 ["%"] comment give information about a file
C00037 00013 ["/"] comment input a portion of a file
C00041 00014 ["O"] comment output a file
C00042 00015 ["D"]["∂"] comment video synthesizer display
C00047 00016 ["!"] comment redraw old video synthesizer display
C00052 00017 ["∃"] comment quick and dirty video synthesizer display
C00056 00018 ["H"] comment high quality halftone
C00058 00019 ["∀"] comment simple halftone display
C00060 00020 ["R"] comment random halftone
C00062 00021 ["A"] comment arty bug halftone
C00064 00022 ["X"] comment send previous halftone to the XGP
C00065 00023 [">"] comment make a DD buffer into an MIT transferrable file
C00066 00024 ["<"] comment display MIT transferrable file
C00068 00025 ["#"] comment switch a video switch output
C00069 00026 ["P"] comment list a picture on the tty
C00072 00027 ["α"] comment add a letter to a font
C00074 00028 ["π"] comment output dd buf to jarvis term.
C00075 00029 ["λ"] comment make an XGPable file
C00077 00030 ["C"] comment step past a certain number of pictures
C00078 00031 ["K"] comment clear the video synthesizer
C00079 00032 ["≡"] comment gronk synthesizer intensity table
C00081 00033 ["S"] comment change size of displays
C00088 00034 ["F"] comment high pass filter
C00089 00035 ["&"] comment measure noise
C00090 00036 [""] comment shrink the picture
C00091 00037 ["L"] comment low pass filter
C00092 00038 ["W"] comment wipe out a window
C00095 00039 ["\"] comment wipe out a window
C00098 00040 ["Z"] comment change size of a picture
C00101 00041 ["~"] comment dequantize a picture
C00104 00042 ["ε"] comment make DD buffer into a picture
C00109 00043 ["$"] comment general geometric transformation
C00114 00044 ["U"] comment remove blank border from a picture
C00116 00045 ["N"] comment apply noise remover
C00117 00046 ["V"] comment apply interest operator
C00118 00047 ["M"] comment pixel modification
C00122 00048 ["G"] comment graph a histogram
C00125 00049 ["J"] comment graph a histogram
C00128 00050 ["E"] comment apply histogram normalizer
C00131 00051 ["Y"] comment apply vert sync loss correction
C00132 00052 ["∞"] comment for hackery
C00134 00053 ["Q"] comment exit
C00135 00054 ELSE PRINT("?",'15&'12)
C00140 ENDMK
C⊗;
BEGIN "PIX"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
require "outdd.rel[s,pmf]" load_module;
external procedure outdd(string s; INTEGER SPOS(2), PPOS(-1));
INTEGER CAMERA,CHR,HIG,WID,BITS,PWANT,PHAVE,PDEFAULT;
STRING BACKLOG; REAL SSIZE,HSIZE,SASPECT,HASPECT;
INTEGER SDISWID,SDISHIG,SYPOS; REAL MAPTF; INTEGER MAPBT;
INTEGER HDISWID,HDISHIG,HAPOS;
BOOLEAN INITED,SYNLAS,HAFTONE;
INTEGER BCL,TCL,SUMS,XEE,YEE,NRTRY;
boolean outddcalled;
REAL TASPECT,TLEN,TWID;
BOOLEAN TBRITE;
REAL LXB,LYB,UXB,UYB;
STRING INPOOT;
INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
INTEGER PROCEDURE PNEXTCH;
RETURN(IF LENGTH(INPOOT)=0 THEN 0 ELSE INPOOT);
INTEGER PROCEDURE NEXTCH;
BEGIN
INTEGER NXC,M,FOO; OWN INTEGER EOF; OWN STRING FN;
PRELOAD_WITH -1; OWN INTEGER ARRAY DEVICE[1:1];
WHILE TRUE DO
IF DEVICE[1]=-1 THEN
BEGIN
IF LENGTH(INPOOT)=0 THEN INPOOT←INCHWL&"↔";
NXC←LOP(INPOOT);
IF NXC="@" THEN
BEGIN
STRING IFL;
DEVICE[1]←GETCHAN;
IFL←"";
WHILE (NXC←LOP(INPOOT))≠"↔" DO IFL←IFL&NXC;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
PRSFIL(IFL);
EOF←TRUE;
OPEN(DEVICE[1],DEVPRS,0,3,0,10,FOO,EOF);
LOOKUP(DEVICE[1],FILPRS,EOF);
BREAKSET(1,"","A");
BREAKSET(1,'12,"X");
BREAKSET(1,'12,"O");
OUTSTR(" reading "&DEVPRS&":"&FILPRS&'15&'12);
FN←DEVPRS&":"&FILPRS;
END
ELSE RETURN(NXC);
END
ELSE
IF EOF THEN
BEGIN
OUTSTR(" finished "&FN&'15&'12);
RELEASE(DEVICE[1]);
DEVICE[1]←-1;
END
ELSE
BEGIN
NXC←INPUT(DEVICE[1],1);
IF NXC='15 THEN NXC←"↔";
RETURN(NXC);
END;
END;
INTEGER PROCEDURE UINCHRW;
BEGIN
INTEGER CH;
DO CH←NEXTCH UNTIL CH≠"↔";
IF EQU(INPOOT,"↔") THEN NEXTCH;
RETURN(CH);
END;
STRING PROCEDURE UINCHWL;
BEGIN
STRING UINCH; INTEGER NC;
UINCH←"";
WHILE (NC←NEXTCH)≠"↔" DO UINCH←UINCH&NC;
RETURN(UINCH);
END;
PROCEDURE UOUTSTR(STRING STRN);
IF PNEXTCH=0 THEN OUTSTR(STRN);
LXB←LYB←-1; UXB←UYB←1;
BCL←7; TCL←0;
YEE←0; XEE←1;
CAMERA←'54; BACKLOG←""; INITED←FALSE; SYNLAS←TRUE; HAFTONE←FALSE;
HIG←260; WID←288; BITS←4; SUMS←1;
PDEFAULT←PWANT←PHAVE←PIXDIM(HIG,WID,BITS);
TASPECT←3/10; TLEN←21; TWID←80; TBRITE←TRUE; NRTRY←15;
SSIZE←HSIZE←.5; SASPECT←HASPECT←481/512; MAPTF←1; MAPBT←4;
SDISWID←HDISWID←SDISHIG←HDISHIG←1; HAPOS←SYPOS←1;
INPOOT←"";
DDINIT; SCREEN(-1,-1,1,1);
synmap(0,-1);
outddcalled←false;
OUTSTR("TYPE ?<CR> FOR COMMAND LIST"&'15&'12);
WHILE TRUE DO
BEGIN "LOOP"
INTEGER ARRAY PIC[0:PHAVE];
IF PHAVE=PDEFAULT THEN
BEGIN
MAKPIX(HIG,WID,BITS,PIC[0]);
INITED←TRUE;
END;
WHILE PHAVE=PWANT DO
BEGIN "SAMEARRAY"
MAPBT←MAPBT MAX PIC[BYBI];
IF LENGTH(BACKLOG)=0 THEN
BEGIN
OUTSTR("*");
DO CHR←UCONV(UINCHRW) UNTIL CHR≠'15;
END
ELSE CHR←UCONV(LOP(BACKLOG));
CASE CHR OF
BEGIN "COMMAND"
["?"]
BEGIN
outddcalled←true;
OUTdd(" Pix Commands
""T"" take a picture from currently selected source
""B"", ""↑"", ""←"" set video digitizer parameters.
B bits/sample, window, ↑ clip levels, ← video source (default=44)
""I"", ""O"", ""β"" i/o pictures from or to a file, ""β"" from a font
""+"", ""*"" add or multiply a picture from file with the current one
""%"", ""/"" for very large files. % gets dimensions, / reads in a part
""D"", ""∂"", ""∃"" display on the video synthesizer, ∂ with grid, ∃ fast
""H"", ""R"", ""A"" or ""∀"" dpy a halftone (H good, R random, A arty, ∀ simple)
""P"", ""λ"" for a character display. P on the terminal, λ for halftone fonts
""X"", ""ε"", ""α"", ""π"", "">"", ""<"" copy the last DD display
X to XGP, ε to picture, α to font, π to PJ dpy, > to and < from MIT files
""S"" set multiplicity, shape and size of displays. default=1x1, 1/2 size
""C"" skip past a number of slots (when displaying multiple pictures)
""K"", ""≡"", ""!"" video synthesizer: K clear, ≡ adjust intensity, ! redraw
""#"" connect a foreign video switch line to a given channel
""W"", ""Z"", ""⊗"", ""$"" geometric. W window, Z size, ⊗ shrink, $ general
""Y"", ""U"", ""\"" Y fix vert sync, U remove black border, \ wipe out a patch
""F"", ""L"", ""N"", ""V"" or ""~"" filter the picture
F high pass, L low pass, N remove noise, V interest, ~ dequantize
""G"" or ""J"" graph the numbers of each grey level. G raw, J integrated
""E"" enhance a picture (normalize the instances of each grey level)
""M"" modify grey levels via a function (entered piecewise linear)
""Q"" quit
Commands may combined using ↔ for <cr>. @FILE reads commands from a file.
");
END;
["T"] comment take a picture via a camera;
BEGIN
INTEGER NRT;
IF PHAVE=PDEFAULT THEN
BEGIN
IF ¬INITED THEN
BEGIN
MAKPIX(HIG,WID,BITS,PIC[0]);
INITED←TRUE;
END;
NRT←CAMPIX(CAMERA,YEE,XEE,PIC[0],SUMS,BCL,TCL,NRTRY);
PRINT(" ",(IF NRT<0 THEN " aborted "&DEVPRS&":"&FILPRS ELSE
CVS(NRT)&" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")),'15&'12);
IF NRT≥0 THEN
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END
ELSE
BEGIN
BACKLOG←"T";
PWANT←PDEFAULT;
END;
END;
["↑"] comment optimize clip levels;
BEGIN
STRING SIN; INTEGER FOO;
UOUTSTR("<CR> FOR AUTO OR TCLIP, BCLIP (0≤TCLIP≤BCLIP≤7):"); SIN←UINCHWL;
IF LENGTH(SIN)≠0 THEN
BEGIN
TCL←INTSCAN(SIN,FOO);
BCL←INTSCAN(SIN,FOO);
END
ELSE
BEGIN
INTEGER NRT;
NRT←CLPADJ(CAMERA,BCL,TCL);
IF NRT<0 THEN OUTSTR(" aborted "&DEVPRS&":"&FILPRS&'15&'12) ELSE
IF NRT>0 THEN OUTSTR(" "&CVS(NRT)&
" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")&'15&'12);
OUTSTR("TCLIP="&CVS(TCL)&" BCLIP="&CVS(BCL)&'15&'12);
END;
END;
["←"] comment alter camera number;
BEGIN
UOUTSTR(" CHANNEL NUMBER:");
CAMERA←CVO(UINCHWL);
BCL←7; TCL←0;
END;
["B"] comment alter bits/pixel, size and # to average;
BEGIN
INTEGER T,FOO; STRING INST;
UOUTSTR(" PICTURE HEIGHT, WIDTH (NOW "&CVS(HIG)&", "&CVS(WID)&"):");
INST←UINCHWL;
IF LENGTH(INST)>2 THEN
BEGIN
HIG←INTSCAN(INST,FOO); WID←INTSCAN(INST,FOO);
END;
UOUTSTR(" PICTURE YEDGE, XEDGE (NOW "&CVS(YEE%2)&", "&CVS(XEE)&"):");
INST←UINCHWL;
IF LENGTH(INST)>2 THEN
BEGIN
YEE←2*INTSCAN(INST,FOO); XEE←INTSCAN(INST,FOO) MAX 1;
END;
UOUTSTR(" NO. OF PICTURES TO AVERAGE (NOW "&CVS(SUMS)&"):");
T←CVD(UINCHWL); IF T>0 THEN SUMS←T;
UOUTSTR(" BITS/PIXEL (NOW "&CVS(BITS)&"):");
T←CVD(UINCHWL); IF T>0 THEN BITS←T MIN 36;
UOUTSTR(" SUPPRESS PARTIAL RETRIES?");
NRTRY←(IF (UINCHWL LAND '137)="Y" THEN -200 ELSE 100);
PDEFAULT←PWANT←PIXDIM(HIG,WID,BITS);
END;
["I"] comment input a file;
BEGIN
OWN STRING FN;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
PWANT←PFLDIM(FN);
BACKLOG←"I"&FN;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE
BEGIN
GETPFL(BACKLOG,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"";
INITED←FALSE;
FN←DEVPRS&":"&FILPRS;
END;
END;
["β"] comment input a font character;
BEGIN
OWN STRING FN; OWN INTEGER CHR,RASH,RASW,ICHAN,NWORD;
REQUIRE "FNTFAI.REL[VIS,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE L1X1(REFERENCE INTEGER PIC; INTEGER YLO,XLO;
REFERENCE INTEGER CHAR);
BOOLEAN PROCEDURE FNTSEL;
BEGIN "FNTSEL"
INTEGER FOO,IFLAG,I,J,POS;
INTEGER ARRAY FHD[0:'205];
PRSFIL(FN);
ICHAN←GETCHAN;
IFLAG←TRUE;
OPEN(ICHAN,DEVPRS,'10,19,0,FOO,FOO,IFLAG);
LOOKUP(ICHAN,FILPRS,IFLAG);
IF IFLAG THEN BEGIN RELEASE(ICHAN); RETURN(FALSE); END;
ARRYIN(ICHAN,FHD[0],'204);
UOUTSTR("CHARACTER:"); CHR←UINCHRW;
POS←FHD[CHR] LAND '777777;
USETI(ICHAN,POS%128 + 1);
FOR I←(POS MOD 128) STEP -1 UNTIL 1 DO WORDIN(ICHAN);
RASW←WORDIN(ICHAN); NWORD←RASW LAND '777777;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←FHD[CHR] LSH -18;
RASH←WORDIN(ICHAN) LAND '777777;
RETURN(TRUE);
END "FNTSEL";
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL("DSK:.FNT[XGP,SYS]");
PRSFIL(FN);
UOUTSTR("FONT:");
IF LENGTH(FN←UINCHWL)>0 ∧ FNTSEL THEN
IF RASW*RASH>0 THEN
BEGIN
PWANT←PIXDIM(RASH,RASW,1);
BACKLOG←"β"&FN;
END
ELSE
BEGIN
PRINT("no letter ",CHR&'15&'12);
FN←DEVPRS&":"&FILPRS;
END
ELSE PRINT("aborted ",DEVPRS,":",FILPRS,'15&'12);
END
ELSE
BEGIN
INTEGER ARRAY PERM[0:1], CHAR[-1:NWORD-2];
MAKPIX(RASH,RASW,1,PIC[0]);
WIPE(PIC[0],0);
CHAR[-1]←RASW LSH 27;
CHAR[0]←RASH;
ARRYIN(ICHAN,CHAR[1],NWORD-2); RELEASE(ICHAN);
L1X1(PIC[0],0,0,CHAR[-1]);
PERM[0]←1; PERM[1]←0;
PERBIT(PIC[0],PERM[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"";
INITED←FALSE;
FN←DEVPRS&":"&FILPRS;
END;
END;
["+"] comment add an input a file;
BEGIN
OWN STRING FN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY T[0:PFLDIM(FN)];
GETPFL(FN,T[0]);
PICADD(T[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
FN←DEVPRS&":"&FILPRS;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["*"] comment multiply by an input a file;
BEGIN
OWN STRING FN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY T[0:PFLDIM(FN)];
GETPFL(FN,T[0]);
PICMUL(T[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
FN←DEVPRS&":"&FILPRS;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["%"] comment give information about a file;
BEGIN
OWN STRING FN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY HD[0:10];
GETPFD(FN,HD[0]);
PRINT(HD[PCLN]," LINES x ",HD[LNBY],
" BYTES/LINE x ",HD[BYBI]," BITS/BYTE",'15&'12);
FN←DEVPRS&":"&FILPRS;
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["/"] comment input a portion of a file;
BEGIN
OWN STRING FN; STRING INFL; OWN INTEGER LY,LX,HY,HX,XCMP,YCMP,BT;
INTEGER FOO; REAL A,B;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)>0 ∧ PFLDIM(FN)>0 THEN
BEGIN
INTEGER ARRAY HD[0:10];
GETPFD(FN,HD[0]);
PRINT(HD[PCLN]," LINES x ",HD[LNBY],
" BYTES/LINE x ",HD[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"/"&FN;
UOUTSTR("LOW Y, HIGH Y:"); INFL←UINCHWL;
LY←A←REALSCAN(INFL,FOO);
HY←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
LY←A*HD[PCLN];
HY←B*HD[PCLN];
END;
IF LY>HY THEN LY↔HY;
LY←LY MAX 0; HY←HY MIN (HD[PCLN]-1);
UOUTSTR("LOW X, HIGH X:"); INFL←UINCHWL;
LX←A←REALSCAN(INFL,FOO);
HX←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
LX←A*HD[LNBY];
HX←B*HD[LNBY];
END;
IF LX>HX THEN LX↔HX;
LX←LX MAX 0; HX←HX MIN (HD[LNBY]-1);
UOUTSTR("COMPRESSION FACTORS (Y, X):"); INFL←UINCHWL;
XCMP←INTSCAN(INFL,FOO);
YCMP←INTSCAN(INFL,FOO);
XCMP←XCMP MAX 1;
IF YCMP≤0 THEN YCMP←XCMP;
HY←(HY-LY+1)%YCMP; HX←(HX-LX+1)%XCMP;
IF HY=0 THEN HY←256; IF HX=0 THEN HX←256;
HY←(HY MAX 1) MIN (HD[PCLN]-LY)%YCMP;
HX←(HX MAX 1) MIN (HD[LNBY]-LX)%XCMP;
UOUTSTR("BITS PER SAMPLE:"); INFL←UINCHWL;
BT←INTSCAN(INFL,FOO); IF BT=0 THEN BT←HD[BYBI];
BT←(BT MAX 1) MIN 36;
PWANT←PIXDIM(HY,HX,BT);
END ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE
BEGIN
FN←DEVPRS&":"&FILPRS;
MAKPIX(HY,HX,BT,PIC[0]);
GETPFP(BACKLOG,PIC[0],LY,LX,YCMP,XCMP);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
BACKLOG←"";
INITED←FALSE;
END;
END;
["O"] comment output a file;
BEGIN
OWN STRING FN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(FN);
UOUTSTR("FILE:");
IF LENGTH(FN←UINCHWL)≠0 THEN
BEGIN
PUTPFL(PIC[0],FN);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END
ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["D"]["∂"] comment video synthesizer display;
BEGIN
INTEGER I,J;
REAL SX,SY,ASP,ASPEN;
REAL PX,PY; INTEGER MODP;
SYNLAS←TRUE;
MODP←SYPOS MOD (SDISWID*SDISHIG);
PX←MODP MOD SDISWID;
MODP←MODP%SDISWID;
PY←SDISHIG-MODP-1;
PX←2*PX-SDISWID+1;
PY←2*PY-SDISHIG+1;
SX←1; SY←1; ASPEN←SASPECT*SDISWID/SDISHIG;
ASP←PIC[PCLN]/PIC[LNBY];
IF ASP>ASPEN THEN SX←ASPEN/ASP ELSE SY←ASP/ASPEN;
SX←SX*SSIZE; SY←SY*SSIZE;
SETFORMAT(0,2);
SCREEN(-SDISWID,-SDISHIG,SDISWID,SDISHIG);
MAPGRY(MAPTF,MAPBT); GRAY(PIC[0]);
I←PIC[BYBI];
IF SYNMAP(I)>0 ∨ SDISHIG*SDISWID>1 THEN
BEGIN
IF SDISHIG*SDISWID>1 THEN GETDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VID(LXB←PX-SX,LYB←PY-SY,UXB←PX+SX,UYB←PY+SY,PIC[0],1);
IF CHR="∂" THEN
BEGIN
INTEGER I;
LITEN;
FOR I←0 STEP 1 UNTIL 10 DO
BEGIN
LINE(LXB+(UXB-LXB)*I/10,LYB,LXB+(UXB-LXB)*I/10,UYB);
LINE(LXB,LYB+(UYB-LYB)*I/10,UXB,LYB+(UYB-LYB)*I/10);
END;
END;
IF SYNMAP(I)>0 THEN
BEGIN
ERASE(SYNMAP(I));
FOR J←1,1 DO DPYUP(SYNMAP(I));
END;
IF SDISHIG*SDISWID>1 THEN PUTDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
END;
FOR I←PIC[BYBI]-1 STEP -1 UNTIL 0 DO
IF SYNMAP(I)>0 ∨ SDISHIG*SDISWID>1 THEN
BEGIN
IF SDISHIG*SDISWID>1 THEN GETDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VID(LXB←PX-SX,LYB←PY-SY,UXB←PX+SX,UYB←PY+SY,
PIC[0],1 LSH (PIC[BYBI]-1-I));
IF CHR="∂" THEN
BEGIN
INTEGER I;
LITEN;
FOR I←0 STEP 1 UNTIL 10 DO
BEGIN
LINE(LXB+(UXB-LXB)*I/10,LYB,LXB+(UXB-LXB)*I/10,UYB);
LINE(LXB,LYB+(UYB-LYB)*I/10,UXB,LYB+(UYB-LYB)*I/10);
END;
END;
IF SYNMAP(I)>0 THEN
BEGIN
ERASE(SYNMAP(I));
FOR J←1,1 DO DPYUP(SYNMAP(I));
END;
IF SDISHIG*SDISWID>1 THEN PUTDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
END;
UNGRAY(PIC[0]);
HAFTONE←TRUE;
SYPOS←SYPOS+1;
OUTSTR("*");
SHOWA('47);
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
END;
["!"] comment redraw old video synthesizer display;
BEGIN
INTEGER I;
MAPGRY(MAPTF,8);
FOR I←7 STEP -1 UNTIL 0 DO
IF SYNMAP(I)≥0 THEN
BEGIN
GETDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
ERASE(SYNMAP(I));
DPYUP(SYNMAP(I));
END;
SHOWA('47);
HAFTONE←TRUE;
END;
["∃"] comment quick and dirty video synthesizer display;
BEGIN
INTEGER I,J;
SYNLAS←TRUE;
SETFORMAT(0,2);
SCREEN(-SDISWID,-SDISHIG,SDISWID,SDISHIG);
MAPGRY(MAPTF,PIC[BYBI]); GRAY(PIC[0]);
FOR I←PIC[BYBI]-1 STEP -1 UNTIL 0 DO
IF SYNMAP(I)>0 THEN
BEGIN
INTEGER XL,YL; REAL X1,Y1,X2,Y2;
DRKEN; RECTAN(-100,-100,100,100);
VIDONE(PIC[0],1 LSH (PIC[BYBI]-1-I),
YL←(481-(PIC[PCLN] MIN 481))%2,
XL←(512-(PIC[LNBY] MIN 512))%2);
XL←XL-(XL MOD 32);
SCREEM(X1,Y1,X2,Y2);
LXB←X1+(X2-X1)*(XL+.5)/512;
UYB←Y1+(Y2-Y1)*(YL+.5)/481;
UXB←X1+(X2-X1)*(XL+PIC[LNBY]+.5)/512;
LYB←Y1+(Y2-Y1)*(YL+PIC[PCLN]+.5)/481;
IF SYNMAP(I)>0 THEN
BEGIN
ERASE(SYNMAP(I));
DPYUP(SYNMAP(I));
END;
END;
UNGRAY(PIC[0]);
HAFTONE←TRUE;
OUTSTR("*");
SHOWA('47);
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
END;
["H"] comment high quality halftone;
BEGIN
INTEGER J,CHN;
REAL SX,SY,ASP,ASPEN;
REAL PX,PY; INTEGER MODP;
SYNLAS←FALSE;
MODP←HAPOS MOD (HDISWID*HDISHIG);
PX←MODP MOD HDISWID;
MODP←MODP%HDISWID;
PY←HDISHIG-MODP-1;
PX←2*PX-HDISWID+1;
PY←2*PY-HDISHIG+1;
SX←1; SY←1; ASPEN←HASPECT*HDISWID/HDISHIG;
ASP←PIC[PCLN]/PIC[LNBY];
IF ASP>ASPEN THEN SX←ASPEN/ASP ELSE SY←ASP/ASPEN;
SX←SX*HSIZE; SY←SY*HSIZE;
SCREEN(-HDISWID,-HDISHIG,HDISWID,HDISHIG);
IF HDISHIG*HDISWID>1 THEN GETDDF("DSK:DD.TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VIDEO(LXB←PX-SX,LYB←PY-SY,UXB←PX+SX,UYB←PY+SY,PIC[0],-2);
CHN←GDDCHN(-1);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
SHOWA(CHN);
HAFTONE←TRUE;
IF HDISHIG*HDISWID>1 THEN PUTDDF("DSK:DD.TMP[TMP,HPM]");
HAPOS←HAPOS+1;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
RDDCHN(CHN);
END;
["∀"] comment simple halftone display;
BEGIN
INTEGER J,CHN,FOO; STRING S;
REAL SX,SY,PX,PY;
SYNLAS←FALSE;
SCREEN(0,0,511,480);
LITEN; RECTAN(-1000,-1000,1000,1000);
UOUTSTR("HEIGHT, WIDTH (IN DD PIXELS):");
SY←REALSCAN(S←UINCHWL,FOO);
SX←REALSCAN(S,FOO);
PX←(512-SX)/2;
PY←(481-SY)/2;
DRKEN; RECTAN(PX,PY,PX+SX,PY+SY);
VIDEO(PX,PY,PX+SX,PY+SY,PIC[0],-2);
CHN←GDDCHN(-1);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
SHOWA(CHN);
HAFTONE←TRUE;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
RDDCHN(CHN);
END;
["R"] comment random halftone;
BEGIN
INTEGER J,CHN;
REAL SX,SY,ASP,ASPEN;
REAL PX,PY; INTEGER MODP;
SYNLAS←FALSE;
MODP←HAPOS MOD (HDISWID*HDISHIG);
PX←MODP MOD HDISWID;
MODP←MODP%HDISWID;
PY←HDISHIG-MODP-1;
PX←2*PX-HDISWID+1;
PY←2*PY-HDISHIG+1;
SX←1; SY←1; ASPEN←HASPECT*HDISWID/HDISHIG;
ASP←PIC[PCLN]/PIC[LNBY];
IF ASP>ASPEN THEN SX←ASPEN/ASP ELSE SY←ASP/ASPEN;
SX←SX*HSIZE; SY←SY*HSIZE;
SCREEN(-HDISWID,-HDISHIG,HDISWID,HDISHIG);
IF HDISHIG*HDISWID>1 THEN GETDDF("DSK:DD.TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VID(LXB←PX-SX,LYB←PY-SY,UXB←PX+SX,UYB←PY+SY,PIC[0],-1);
CHN←GDDCHN(-1);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
SHOWA(CHN);
HAFTONE←TRUE;
IF HDISHIG*HDISWID>1 THEN PUTDDF("DSK:DD.TMP[TMP,HPM]");
HAPOS←HAPOS+1;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
RDDCHN(CHN);
END;
["A"] comment arty bug halftone;
BEGIN
INTEGER J,CHN;
REAL SX,SY,ASP,ASPEN;
REAL PX,PY; INTEGER MODP;
SYNLAS←FALSE;
MODP←HAPOS MOD (HDISWID*HDISHIG);
PX←MODP MOD HDISWID;
MODP←MODP%HDISWID;
PY←HDISHIG-MODP-1;
PX←2*PX-HDISWID+1;
PY←2*PY-HDISHIG+1;
SX←1; SY←1; ASPEN←HASPECT*HDISWID/HDISHIG;
ASP←PIC[PCLN]/PIC[LNBY];
IF ASP>ASPEN THEN SX←ASPEN/ASP ELSE SY←ASP/ASPEN;
SX←SX*HSIZE; SY←SY*HSIZE;
SCREEN(-HDISWID,-HDISHIG,HDISWID,HDISHIG);
IF HDISHIG*HDISWID>1 THEN GETDDF("DSK:DD.TMP[TMP,HPM]");
DRKEN; RECTAN(PX-1,PY-1,PX+1,PY+1);
VIDEO(LXB←PX-SX,LYB←PY-SY,UXB←PX+SX,UYB←PY+SY,PIC[0],-4);
CHN←GDDCHN(-1);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
SHOWA(CHN);
HAFTONE←TRUE;
IF HDISHIG*HDISWID>1 THEN PUTDDF("DSK:DD.TMP[TMP,HPM]");
HAPOS←HAPOS+1;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
SHOW(-1);
RDDCHN(CHN);
END;
["X"] comment send previous halftone to the XGP;
BEGIN
INTEGER J;
UOUTSTR("SIZE (-5 to +5):");
J←CVD(UINCHWL);
IF J≠0 THEN
BEGIN
IF HAFTONE THEN BEGIN INVEN; RECTAN(-1000,-1000,1000,1000); END;
XGPUP(J);
IF HAFTONE THEN BEGIN INVEN; RECTAN(-1000,-1000,1000,1000); END;
END
ELSE
OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
[">"] comment make a DD buffer into an MIT transferrable file;
BEGIN
OWN STRING FN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL("DSK:.SU");
PRSFIL(FN);
UOUTSTR("OUTPUT FILE NAME:");
IF ¬PUTMIT(UINCHWL) THEN OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12)
ELSE
BEGIN
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
END;
["<"] comment display MIT transferrable file;
BEGIN
OWN STRING FN;
INTEGER J,CHN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL("DSK:.MIT");
PRSFIL(FN);
UOUTSTR("INPUT FILE NAME:");
DRKEN; RECTAN(-100,-100,100,100);
IF ¬GETMIT(UINCHWL) THEN OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12)
ELSE
BEGIN
CHN←GDDCHN(-1);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
SHOWA(CHN);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
FN←DEVPRS&":"&FILPRS;
END;
END;
["#"] comment switch a video switch output;
BEGIN
INTEGER J,K;
UOUTSTR(" LINE:"); J←CVO(UINCHWL);
UOUTSTR("CHANNEL:"); K←CVO(UINCHWL);
SHOW(K,J);
END;
["P"] comment list a picture on the tty;
BEGIN
INTEGER I,J,K,L,M;
REAL ASP;
INTEGER SX,SY;
ASP←PIC[PCLN]/PIC[LNBY];
SX←TWID; SY←SX*ASP*TASPECT;
IF SY>TLEN THEN BEGIN SX←SX*TLEN/SY; SY←TLEN; END;
BEGIN
REAL PCMAX;
PCMAX←2↑PIC[BYBI]-1;
CALL(0,"RESET");
OUTSTR('15&'12);
FOR J←0 STEP 1 UNTIL SY-1 DO
BEGIN
FOR I←0 STEP 1 UNTIL SX-1 DO
BEGIN
PRELOAD_WITH " ","`",".","-","'","/",":","+","1","[","0",
"X","%","A","Q","M","*";
OWN INTEGER ARRAY GRT[0:16];
IF TBRITE THEN
OUTSTR(GRT[16*PIXEL(PIC[0],PIC[PCLN]*J%SY,PIC[LNBY]*I%SX)/PCMAX])
ELSE
OUTSTR(GRT[16*
(1-PIXEL(PIC[0],PIC[PCLN]*J%SY,PIC[LNBY]*I%SX)/PCMAX)]);
END;
OUTSTR('15&'12);
END;
END;
END;
["α"] comment add a letter to a font;
BEGIN
INTEGER LETR; OWN STRING FOFIL;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT");
PRSFIL(FOFIL);
UOUTSTR("FONT FILE:"); FOFIL←UINCHWL;
UOUTSTR("LETTER:"); LETR←UINCHWL;
IF HAFTONE THEN BEGIN INVEN; RECTAN(-1000,-1000,1000,1000); END;
DDFONT(LXB,LYB,UXB,UYB, FOFIL, LETR);
IF HAFTONE THEN BEGIN INVEN; RECTAN(-1000,-1000,1000,1000); END;
FOFIL←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
["π"] comment output dd buf to jarvis term.;
begin
if ¬pjup then outstr("failed") else show('41);
end;
["λ"] comment make an XGPable file;
BEGIN
INTEGER I,J,K,L,M,CHN; REAL D,G,O; STRING S; OWN STRING FN;
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".TXT");
PRSFIL(FN);
DO
BEGIN
UOUTSTR("XGP OUTPUT FILE NAME:");
PRSFIL(FN←UINCHWL);
M←1;
CHN←GETCHAN;
OPEN(CHN,DEVPRS,0,0,19,0,0,M);
ENTER(CHN,FILPRS,M);
END
UNTIL ¬M;
UOUTSTR("DENSITY (0 (normal) to 1):"); D←REALSCAN(S←UINCHWL,M);
O←'77+'40*D; G←(D+1)*'40/(1+PIC[BMAX]);
FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
FOR J←0 STEP 1 UNTIL PIC[LNBY]-1 DO
OUT(CHN,M←O-G*PIXEL(PIC[0],I,J));
OUT(CHN,'15&'12);
END;
CLOSE(CHN); RELEASE(CHN);
FN←DEVPRS&":"&FILPRS; OUTSTR("wrote "&DEVPRS&":"&FILPRS&'15&'12);
END;
["C"] comment step past a certain number of pictures;
BEGIN
INTEGER T;
UOUTSTR("SKIP HOW MANY (NEGATIVE TO BACKSPACE):");
T←CVD(UINCHWL);
IF SYNLAS THEN SYPOS←SYPOS+T ELSE HAPOS←HAPOS+T;
END;
["K"] comment clear the video synthesizer;
BEGIN
INTEGER T;
FOR T←0 STEP 1 UNTIL 7 DO ERASE(SYNMAP(T));
END;
["≡"] comment gronk synthesizer intensity table;
BEGIN
STRING SI; INTEGER I;
UOUTSTR("TRANSFER FUNCTION (about -2.0 to 2.0):");
IF ¬MAPGRY(MAPTF←REALSCAN(SI←UINCHWL,I),MAPBT) THEN
OUTSTR("failed"&'15&'12);
END;
["S"] comment change size of displays;
BEGIN
STRING INP; INTEGER FOO,INC;
REAL T;
UOUTSTR("FOR SYNTHESIZER, HALFTONES OR PRINTOUT (S, H OR P)?");
INC←UCONV(UINCHWL);
IF INC="S" THEN
BEGIN
INTEGER I;
SYNLAS←TRUE;
SETFORMAT(0,2);
UOUTSTR("PICTURE SIZE (1 IS FULLSIZE, NOW"&CVF(SSIZE)&"):"); INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN SSIZE←ABS(T);
UOUTSTR("ASPECT RATIO (HEIGHT/WIDTH OF SCREEN, NOW"&CVF(SASPECT)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T>0 THEN SASPECT←T;
UOUTSTR("NUMBER OF PICTURES IN X DIRECTION:");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠SDISWID THEN
BEGIN
SDISWID←T;
SYPOS←0;
END;
UOUTSTR("NUMBER OF PICTURES IN Y DIRECTION:");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠SDISHIG THEN
BEGIN
SDISHIG←T;
SYPOS←0;
END;
SCREEN(-1,-1,1,1);
DRKEN; RECTAN(-1000,-1000,1000,1000);
IF SDISHIG*SDISWID>1 THEN
BEGIN
UOUTSTR("ERASE?");
IF UCONV(UINCHWL)="Y" THEN
FOR I←0 STEP 1 UNTIL 7 DO
PUTDDF("DSK:DD"&CVS(I)&".TMP[TMP,HPM]");
END;
END
ELSE IF INC="H" THEN
BEGIN
SYNLAS←FALSE;
SETFORMAT(0,2);
UOUTSTR("PICTURE SIZE (1 IS FULLSIZE, NOW"&CVF(HSIZE)&"):"); INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN HSIZE←ABS(T);
UOUTSTR("ASPECT RATIO (HEIGHT/WIDTH OF SCREEN, NOW"&CVF(HASPECT)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T>0 THEN HASPECT←T;
UOUTSTR("NUMBER OF PICTURES IN X DIRECTION:");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠HDISWID THEN
BEGIN
HDISWID←T;
HAPOS←0;
END;
UOUTSTR("NUMBER OF PICTURES IN Y DIRECTION:");
T←ABS(CVD(UINCHWL));
IF T>0∧T≠HDISHIG THEN
BEGIN
HDISHIG←T;
HAPOS←0;
END;
SCREEN(-1,-1,1,1);
DRKEN; RECTAN(-1000,-1000,1000,1000);
IF HDISHIG*HDISWID>1 THEN PUTDDF("DSK:DD.TMP[TMP,HPM]");
END
ELSE IF INC="P" THEN
BEGIN
SETFORMAT(0,2);
UOUTSTR("ASPECT RATIO OF TTY (CHRS/IN, VERTICAL/HORIZONTAL, NOW "&
CVF(TASPECT)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN TASPECT←ABS(T);
UOUTSTR("WIDTH OF TTY DISPLAYS (NOW "&CVS(TWID)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN TWID←ABS(T);
UOUTSTR("MAXIMUM HEIGHT OF TTY DISPLAYS (NOW "&CVS(TLEN)&"):");
INP←UINCHWL;
T←REALSCAN(INP,FOO);
IF T≠0 THEN TLEN←ABS(T);
UOUTSTR("ARE LETTERS BRIGHT OR DARK (NOW "&
(IF TBRITE THEN "BRIGHT" ELSE "DARK")&"):");
TBRITE←¬(UCONV(UINCHWL)="D");
END;
END;
["F"] comment high pass filter;
BEGIN
INTEGER WINDOW;
UOUTSTR(" WINDOW SIZE:");
WINDOW←CVD(UINCHWL);
IF WINDOW>1 THEN
BEGIN
INTEGER ARRAY T[0:PHAVE];
PASSHI(PIC[0],WINDOW,T[0]);
ENHANCE(T[0]);
COPPIC(T[0],PIC[0]);
END
ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["&"] comment measure noise;
BEGIN
OUTSTR(" NOISE FIGURE:"&CVF(NOISE(PIC[0]))&'15&'12);
END;
["⊗"] comment shrink the picture;
BEGIN
INTEGER ARRAY T[0:PHAVE];
IF PIC[PCLN]≥2∧PIC[LNBY]≥2 THEN
BEGIN
HAFPIC(PIC[0],T[0],9);
COPPIC(T[0],PIC[0]);
END;
PWANT←PHAVE←PIXDIM(PIC[PCLN],PIC[LNBY],PIC[BYBI]);
INITED←FALSE;
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END;
["L"] comment low pass filter;
BEGIN
LOWPAS(PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
END;
["W"] comment wipe out a window;
BEGIN
INTEGER XL,XH,YL,YH,FOO; REAL A,B;
STRING INFL;
UOUTSTR("LOW Y, HIGH Y:"); INFL←UINCHWL;
YL←A←REALSCAN(INFL,FOO);
YH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
YL←A*PIC[PCLN];
YH←B*PIC[PCLN];
END;
IF YL>YH THEN YL↔YH;
YL←YL MAX 0; YH←YH MIN (PIC[PCLN]-1);
IF (YH-YL+1)>0 THEN
BEGIN
UOUTSTR("LOW X, HIGH X:"); INFL←UINCHWL;
XL←A←REALSCAN(INFL,FOO);
XH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
XL←A*PIC[LNBY];
XH←B*PIC[LNBY];
END;
IF XL>XH THEN XL↔XH;
XL←XL MAX 0; XH←XH MIN (PIC[LNBY]-1);
IF (XH-XL+1)>0 THEN
BEGIN
INTEGER ARRAY T[0:PIXDIM(YH-YL+1,XH-XL+1,PIC[BYBI])];
MAKPIX(YH-YL+1,XH-XL+1,PIC[BYBI],T[0]);
SELECT(PIC[0],YL,XL,T[0]);
COPPIC(T[0],PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
PWANT←PHAVE←PIXDIM(PIC[PCLN],PIC[LNBY],PIC[BYBI]);
INITED←FALSE;
END;
END;
END;
["\"] comment wipe out a window;
BEGIN
INTEGER XL,XH,YL,YH,FOO; REAL A,B;
STRING INFL;
UOUTSTR("LOW Y, HIGH Y:"); INFL←UINCHWL;
YL←A←REALSCAN(INFL,FOO);
YH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
YL←A*PIC[PCLN];
YH←B*PIC[PCLN];
END;
IF YL>YH THEN YL↔YH;
YL←YL MAX 0; YH←YH MIN (PIC[PCLN]-1);
IF (YH-YL+1)>0 THEN
BEGIN
UOUTSTR("LOW X, HIGH X:"); INFL←UINCHWL;
XL←A←REALSCAN(INFL,FOO);
XH←B←REALSCAN(INFL,FOO);
IF ABS(A)≤1 ∧ ABS(B)≤1 THEN
BEGIN
XL←A*PIC[LNBY];
XH←B*PIC[LNBY];
END;
IF XL>XH THEN XL↔XH;
XL←XL MAX 0; XH←XH MIN (PIC[LNBY]-1);
IF (XH-XL+1)>0 THEN
BEGIN
INTEGER VAL,I,J;
OUTSTR("PIXEL VALUE:"); VAL←CVD(INCHWL);
FOR I←YL STEP 1 UNTIL YH DO
FOR J←XL STEP 1 UNTIL XH DO
PUTEL(PIC[0],I,J,VAL);
END;
END;
END;
["Z"] comment change size of a picture;
BEGIN
OWN INTEGER LHIG,LWID,LBITS;
INTEGER FOO;
STRING INFL;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
UOUTSTR("DILATION FACTORS (EG. .5 = HALF SIZE) Y, X:"); INFL←UINCHWL;
LHIG←ABS(REALSCAN(INFL,FOO))*PIC[PCLN]; IF LHIG=0 THEN LHIG←PIC[PCLN];
LWID←ABS(REALSCAN(INFL,FOO))*PIC[LNBY]; IF LWID=0 THEN LWID←PIC[LNBY];
UOUTSTR("NUMBER OF BITS:"); LBITS←(CVD(UINCHWL) MIN 36);
IF LBITS≤0 THEN LBITS←PIC[BYBI];
IF LBITS≠PIC[BYBI]∨LWID≠PIC[LNBY]∨LHIG≠PIC[PCLN] THEN
BEGIN
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBITS);
BACKLOG←"Z ";
END;
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(LHIG,LWID,LBITS,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
SHRINK(T[0],PIC[0]);
BACKLOG←"";
INITED←FALSE;
END;
END;
["~"] comment dequantize a picture;
BEGIN
OWN INTEGER LHIG,LWID,LBITS;
INTEGER FOO;
STRING INFL;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
LHIG←2*PIC[PCLN];
LWID←2*PIC[LNBY];
LBITS←PIC[BYBI];
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
PWANT←PIXDIM(LHIG,LWID,LBITS);
BACKLOG←"~ ";
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("TMP.TMP[TMP,HPM]")];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(LHIG,LWID,LBITS,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
SHRINK(T[0],PIC[0]);
LOWPAS(PIC[0]);
BACKLOG←"";
INITED←FALSE;
END;
END;
["ε"] comment make DD buffer into a picture;
BEGIN
OWN INTEGER LHIG,LWID,LBITS;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
LHIG←481; LWID←512; LBITS←1;
PWANT←PIXDIM(HIG,WID,BITS);
BACKLOG←"ε ";
END
ELSE
BEGIN
INTEGER I;
MAKPIX(LHIG,LWID,LBITS,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
FOR I ← 0 STEP 1 UNTIL 480 DO
DDPAK(I,MEMORY[PIC[LINTAB+I]],0,511);
BACKLOG←"";
INITED←FALSE;
END;
END;
["$"] comment general geometric transformation;
BEGIN
OWN INTEGER HIG,WID,BITS;
INTEGER FOO;
STRING INFL;
own string tr1,tr2,tr3;
IF LENGTH(BACKLOG)=0 THEN
BEGIN
integer com;
UOUTSTR("Transform (? for help):"); com←UINCHRW;
WHILE com="?" DO
BEGIN
Uoutstr("
R Rotate
E Enter transform matrix
Transform:");
com←UINCHRW;
END;
COM←COM LAND '137;
if com="R" then
begin
REAL RT,SRT,CRT;
UOUTSTR("What fraction of a full turn:");
RT←REALSCAN(INFL←UINCHWL,FOO);
SRT←SIN(2*3.14159265*RT); CRT←COS(2*3.14159265*RT);
SETFORMAT(0,4);
TR1←CVF(CRT)&" "&CVF(SRT)&" "&CVF(.5*(1-SRT-CRT));
TR2←CVF(-SRT)&" "&CVF(CRT)&" "&CVF(.5*(1+SRT-CRT));
TR3←"0 0 1";
HIG←PIC[PCLN]*ABS(CRT)+PIC[LNBY]*ABS(SRT);
WID←PIC[LNBY]*ABS(CRT)+PIC[PCLN]*ABS(SRT);
RT←SQRT(PIC[PCLN]*PIC[LNBY]/(HIG*WID));
HIG←HIG*RT+.5;
WID←WID*RT+.5;
BITS←PIC[BYBI];
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
end
else if com="E" then
begin
Uoutstr("Enter transform matrix."&'15&'12);
Uoutstr("tr[1,1:3] ← ");loded(tr1&'12);tr1←UINCHWL;
Uoutstr("tr[2,1:3] ← ");loded(tr2&'12);tr2←UINCHWL;
Uoutstr("tr[3,1:3] ← ");loded(tr3&'12);tr3←UINCHWL;
Uoutstr("height width bits ← ");
loded(cvs(pic[pcln])&" "&cvs(pic[lnby])
&" "&cvs( pic[bybi] ) & '12); infl ← UINCHWL;
hig←intscan(infl,foo);
wid←intscan(infl,foo);
bits←intscan(infl,foo);
PUTPFL(PIC[0],"DSK:TMP.TMP[TMP,HPM]");
end;
PWANT←PIXDIM(HIG,WID,BITS);
BACKLOG←"$ ";
END
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM("DSK:TMP.TMP[TMP,HPM]")];
real array tr[1:3,1:3];
GETPFL("DSK:TMP.TMP[TMP,HPM]",T[0]);
MAKPIX(HIG,WID,BITS,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
infl←tr1;tr[1,1]←realscan(infl,foo);tr[1,2]←realscan(infl,foo);tr[1,3]←realscan(infl,foo);
infl←tr2;tr[2,1]←realscan(infl,foo);tr[2,2]←realscan(infl,foo);tr[2,3]←realscan(infl,foo);
infl←tr3;tr[3,1]←realscan(infl,foo);tr[3,2]←realscan(infl,foo);tr[3,3]←realscan(infl,foo);
pixtrn(t[0],tr,pic[0]);
BACKLOG←"";
INITED←FALSE;
END;
END;
["U"] comment remove blank border from a picture;
BEGIN
INTEGER ARRAY ROW[0:PIC[PCLN]-1],COL[0:PIC[LNBY]-1];
INTEGER FHX,FHY,I,K,FLX,FLY;
ROWSUM(PIC[0],ROW[0]);
K←0; FOR I←0 STEP 1 UNTIL PIC[PCLN]-1 DO K←K+ROW[I];
K←K/PIC[PCLN]; FLY←0; WHILE ROW[FLY]<K/2 DO FLY←FLY+1;
FHY←PIC[PCLN]-1; WHILE ROW[FHY]<K/2 DO FHY←FHY-1;
IF ROW[FLY]<K/1.5 THEN FLY←FLY+1;
IF ROW[FLY]<K/1.5 THEN FLY←FLY+1;
COLSUM(PIC[0],COL[0]);
K←0; FOR I←0 STEP 1 UNTIL PIC[LNBY]-1 DO K←K+COL[I];
K←K/PIC[LNBY]; FLX←0; WHILE COL[FLX]<K/2 DO FLX←FLX+1;
FHX←PIC[LNBY]-1; WHILE COL[FHX]<K/2 DO FHX←FHX-1;
WID←FHX-FLX+1; HIG←FHY-FLY+1;
IF BITS≠PIC[BYBI]∨WID≠PIC[LNBY]∨HIG≠PIC[PCLN] THEN
BEGIN
INTEGER ARRAY T[0:PHAVE];
COPPIC(PIC[0],T[0]);
MAKPIX(HIG,WID,BITS,PIC[0]);
SELECT(T[0],FLY,FLX,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
PHAVE←PWANT←PIXDIM(HIG,WID,BITS);
INITED←FALSE;
END;
END;
["N"] comment apply noise remover;
BEGIN
CLEAN(PIC[0]);
END;
["V"] comment apply interest operator;
BEGIN
INTEGER WINDOW;
UOUTSTR(" WINDOW SIZE:"); WINDOW←CVD(UINCHWL);
IF WINDOW≥1 THEN
BEGIN
INTEREST(PIC[0],WINDOW,PIC[0]);
PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
" BYTES/LINE x ",PIC[BYBI]," BITS/BYTE",'15&'12);
PWANT←PHAVE←PIXDIM(PIC[PCLN],PIC[LNBY],PIC[BYBI]);
INITED←FALSE;
END
ELSE OUTSTR("aborted "&DEVPRS&":"&FILPRS&'15&'12);
END;
["M"] comment pixel modification;
IF PIC[BYBI]>10 THEN PRINT("More than 10 bits/sample",'15&'12)
ELSE
BEGIN
PRELOAD_WITH -1;
OWN INTEGER ARRAY PERM[-1:1024];
INTEGER FOO,I,J; STRING INP;
INTEGER NUMP;
IF PERM[-1]≠PIC[BYBI] THEN
BEGIN
FOR I←0 STEP 1 UNTIL PIC[BMAX] DO PERM[I]←I;
PERM[-1]←PIC[BYBI];
END;
BEGIN
INTEGER ARRAY OLD,NEW[0:100];
UOUTSTR(CVS(PIC[BMAX])&" is maximum grey level"&
" enter piecewise linear link points"&'15&'12&
" old value , new value end with a blank line"&'15&'12);
NUMP←0;
WHILE LENGTH(INP←UINCHWL)>0 DO
BEGIN
NUMP←NUMP+1;
OLD[NUMP]←REALSCAN(INP,FOO);
NEW[NUMP]←REALSCAN(INP,FOO);
IF OLD[NUMP]<0∨OLD[NUMP]>PIC[BMAX] THEN
BEGIN PRINT("rejected",'15&'12); NUMP←NUMP-1; END;
END;
FOR I←1 STEP 1 UNTIL NUMP-1 DO
FOR J←I+1 STEP 1 UNTIL NUMP DO
IF OLD[I]>OLD[J] THEN BEGIN OLD[I]↔OLD[J]; NEW[I]↔NEW[J]; END;
IF NUMP>0 THEN
BEGIN OLD[NUMP+1]←OLD[NUMP]; NEW[NUMP+1]←NEW[NUMP]; END;
FOR I←1 STEP 1 UNTIL NUMP DO
BEGIN
FOR J←OLD[I] STEP 1 UNTIL OLD[I+1] DO
PERM[J]←(NEW[I+1]*(J-OLD[I])+NEW[I]*(OLD[I+1]-J+1))
%(OLD[I+1]+1-OLD[I]);
END;
END;
PERBIT(PIC[0],PERM[0]);
END;
["G"] comment graph a histogram;
BEGIN
INTEGER ARRAY HIST[0:PIC[BMAX]+1];
INTEGER FOO,I,J,MAV,CHN;
CHN←GDDCHN(-1);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
FOO←2↑PIC[BYBI]-1;
HISTOG(PIC[0],HIST[0]);
SCREEN(-.3,-.2,1.1,1.2);
DRKEN; RECTAN(-100,-100,100,100);
LITEN;
LINE(0,0,0,1); LINE(0,1,1,1);
LINE(1,1,1,0); LINE(1,0,0,0);
LINE(0,.5,1,.5); LINE(0,.25,1,.25); LINE(0,.75,1,.75);
LINE(.5,0,.5,1); LINE(.25,0,.25,1); LINE(.75,0,.75,1);
MAV←0; FOR I←0 STEP 1 UNTIL FOO DO MAV←MAV MAX HIST[I];
MAV←MAV+1;
FOR I←1 STEP 1 UNTIL FOO DO
LINE((I-1)/FOO,HIST[I-1]/MAV,I/FOO,HIST[I]/MAV);
TXTPOS(0,-1/10,1/24,1/12); TEXT("0");
TXTPOS(1-LENGTH(CVS(2↑PIC[BYBI]))/24,-1/10,1/24,1/12);
TEXT(CVS(2↑PIC[BYBI]-1));
TXTPOS(-.07,0,1/24,1/12); TEXT("0");
TXTPOS(-.07-(LENGTH(CVS(MAV))-1)/24,1-1/12,1/24,1/12); TEXT(CVS(MAV));
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
HAFTONE←FALSE; LXB←LYB←-1; UXB←UYB←1;
SHOWA(CHN);
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
END;
["J"] comment graph a histogram;
BEGIN
INTEGER ARRAY HIST[0:PIC[BMAX]+1];
INTEGER FOO,I,J,L,MAV,CHN;
CHN←GDDCHN(-1);
OUTSTR(" CHANNEL "&CVOS(CHN)&'15&'12);
FOO←2↑PIC[BYBI]-1;
HISTOG(PIC[0],HIST[0]);
SCREEN(-.3,-.2,1.1,1.2);
DRKEN; RECTAN(-100,-1000,1000,1000);
LITEN;
LINE(0,0,0,1); LINE(0,1,1,1);
LINE(1,1,1,0); LINE(1,0,0,0);
LINE(0,.5,1,.5); LINE(0,.25,1,.25); LINE(0,.75,1,.75);
LINE(.5,0,.5,1); LINE(.25,0,.25,1); LINE(.75,0,.75,1);
MAV←0; FOR I←0 STEP 1 UNTIL FOO DO MAV←MAV + HIST[I];
L←J←0;
FOR I←1 STEP 1 UNTIL FOO DO
BEGIN
L←J;
J←J+HIST[I];
LINE((I-1)/FOO,L/MAV,I/FOO,J/MAV);
END;
TXTPOS(0,-1/10,1/24,1/12); TEXT("0");
TXTPOS(1-LENGTH(CVS(2↑PIC[BYBI]))/24,-1/10,1/24,1/12);
TEXT(CVS(2↑PIC[BYBI]-1));
TXTPOS(-.07,0,1/24,1/12); TEXT("0");
TXTPOS(-.07-(LENGTH(CVS(MAV))-1)/24,1-1/12,1/24,1/12); TEXT(CVS(MAV));
ERASE(CHN);
FOR J←1,1 DO DPYUP(CHN);
SHOWA(CHN);
HAFTONE←FALSE; LXB←LYB←-1; UXB←UYB←1;
OUTSTR("*");
DO BACKLOG←UINCHRW UNTIL BACKLOG≠'15∧BACKLOG≠'12;
RDDCHN(CHN);
SHOW(-1);
END;
["E"] comment apply histogram normalizer;
BEGIN
ENHANCE(PIC[0]);
END;
["Y"] comment apply vert sync loss correction;
BEGIN
SYNCHRONIZE(PIC[0]);
END;
["∞"] comment for hackery;
BEGIN
INTEGER I,J;
INTEGER ARRAY T[0:PIXDIM(PIC[PCLN],PIC[LNBY],PIC[BYBI])];
COPPIC(PIC[0],T[0]);
FOR I←PIC[PCLN]-2 STEP -1 UNTIL 1 DO
FOR J←PIC[LNBY]-2 STEP -1 UNTIL 1 DO
PUTEL(PIC[0],I,J,
(PIXEL(T[0],I-1,J-1) + 2*PIXEL(T[0],I-1,J) + PIXEL(T[0],I-1,J+1)
+2*PIXEL(T[0],I,J-1) + 4*PIXEL(T[0],I,J) + 2*PIXEL(T[0],I,J+1)
+PIXEL(T[0],I+1,J-1) + 2*PIXEL(T[0],I+1,J) + PIXEL(T[0],I+1,J+1)
)/16+0.5);
END;
["Q"] comment exit;
BEGIN
if outddcalled then OUTDD('40&'15&'12);
CALL(0,"EXIT");
END;
ELSE PRINT("?",'15&'12)
END "COMMAND";
END "SAMEARRAY";
PHAVE←PWANT;
END "LOOP";
END "PIX";